home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ediff / ediff-vers.el.z / ediff-vers.el
Encoding:
Text File  |  1998-05-21  |  12.8 KB  |  378 lines
  1. ;;; ediff-vers.el --- version control interface to Ediff
  2.  
  3. ;;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24.  
  25. ;;; Code:
  26.  
  27. ;; Compiler pacifier
  28. (defvar rcs-default-co-switches)
  29. (defvar sc-mode)
  30. (defvar cvs-shell)
  31. (defvar cvs-program)
  32. (defvar cvs-cookie-handle)
  33. (defvar ediff-temp-file-prefix)
  34.  
  35. (and noninteractive
  36.      (eval-when-compile
  37.        (load "pcl-cvs" 'noerror)
  38.        (load "rcs" 'noerror)
  39.        (load "generic-sc" 'noerror)
  40.        (load "vc" 'noerror)))
  41. ;; end pacifier
  42.       
  43. ;; VC.el support
  44. (defun ediff-vc-internal (rev1 rev2 &optional startup-hooks)
  45. ;; Run Ediff on versions of the current buffer.
  46. ;; If REV2 is "" then compare current buffer with REV1.
  47. ;; If the current buffer is named `F', the version is named `F.~REV~'.
  48. ;; If `F.~REV~' already exists, it is used instead of being re-created.
  49.   (let (file1 file2 rev1buf rev2buf)
  50.     (save-excursion
  51.       (vc-version-other-window rev1)
  52.       (setq rev1buf (current-buffer)
  53.         file1 (buffer-file-name)))
  54.     (save-excursion
  55.       (or (string= rev2 "")         ; use current buffer
  56.       (vc-version-other-window rev2))
  57.       (setq rev2buf (current-buffer)
  58.         file2 (buffer-file-name)))
  59.     (setq startup-hooks
  60.       (cons (` (lambda ()
  61.              (delete-file (, file1))
  62.              (or (, (string= rev2 "")) (delete-file (, file2)))
  63.              ))
  64.         startup-hooks))
  65.     (ediff-buffers
  66.      rev1buf rev2buf
  67.      startup-hooks
  68.      'ediff-revision)))
  69.     
  70. ;; RCS.el support
  71. (defun rcs-ediff-view-revision (&optional rev)
  72. ;; View previous RCS revision of current file.
  73. ;; With prefix argument, prompts for a revision name.
  74.   (interactive (list (if current-prefix-arg 
  75.              (read-string "Revision: "))))
  76.   (let* ((filename (buffer-file-name (current-buffer)))
  77.      (switches (append '("-p")
  78.                (if rev (list (concat "-r" rev)) nil)))
  79.      (buff (concat (file-name-nondirectory filename) ".~" rev "~")))
  80.     (message "Working ...")
  81.     (setq filename (expand-file-name filename))
  82.     (with-output-to-temp-buffer buff
  83.       (let ((output-buffer (ediff-rcs-get-output-buffer filename buff)))
  84.     (delete-windows-on output-buffer)
  85.     (save-excursion
  86.       (set-buffer output-buffer)
  87.       (apply 'call-process "co" nil t nil
  88.          ;; -q: quiet (no diagnostics)
  89.          (append switches rcs-default-co-switches
  90.              (list "-q" filename))))) 
  91.       (message "")
  92.       buff)))    
  93.       
  94. (defun ediff-rcs-get-output-buffer (file name)
  95.   ;; Get a buffer for RCS output for FILE, make it writable and clean it up.
  96.   ;; Optional NAME is name to use instead of `*RCS-output*'.
  97.   ;; This is a modified version from rcs.el v1.1. I use it here to make
  98.   ;; Ediff immune to changes in rcs.el
  99.   (let* ((default-major-mode 'fundamental-mode) ; no frills!
  100.      (buf (get-buffer-create name)))
  101.     (save-excursion
  102.       (set-buffer buf)
  103.       (setq buffer-read-only nil
  104.         default-directory (file-name-directory (expand-file-name file)))
  105.       (erase-buffer))
  106.     buf))
  107.  
  108. (defun ediff-rcs-internal (rev1 rev2 &optional startup-hooks)
  109. ;; Run Ediff on versions of the current buffer.
  110. ;; If REV2 is "" then use current buffer.
  111.   (let ((rev2buf (if (string= rev2 "")
  112.              (current-buffer)
  113.            (rcs-ediff-view-revision rev2)))
  114.     (rev1buf (rcs-ediff-view-revision rev1)))
  115.     
  116.     ;; rcs.el doesn't create temp version files, so we don't have to delete
  117.     ;; anything in startup hooks to ediff-buffers
  118.     (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)
  119.     ))
  120.  
  121.  
  122. ;; GENERIC-SC.el support
  123.  
  124. (defun generic-sc-get-latest-rev ()
  125.   (cond ((eq sc-mode 'CCASE)
  126.      (eval "main/LATEST"))
  127.     (t (eval ""))))
  128.  
  129. (defun ediff-generic-sc-internal (rev1 rev2 &optional startup-hooks)
  130. ;; Run Ediff on versions of the current buffer.
  131. ;; If REV2 is "" then compare current buffer with REV1.
  132. ;; If the current buffer is named `F', the version is named `F.~REV~'.
  133. ;; If `F.~REV~' already exists, it is used instead of being re-created.
  134.   (let (rev1buf rev2buf)
  135.     (save-excursion
  136.       (if (or (not rev1) (string= rev1 ""))
  137.       (setq rev1 (generic-sc-get-latest-rev)))
  138.       (sc-visit-previous-revision rev1)
  139.       (setq rev1buf (current-buffer)))
  140.     (save-excursion
  141.       (or (string= rev2 "")         ; use current buffer
  142.       (sc-visit-previous-revision rev2))
  143.       (setq rev2buf (current-buffer)))
  144.     (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)))
  145.  
  146.  
  147. ;;; Merge with Version Control
  148.  
  149. (defun ediff-vc-merge-internal (rev1 rev2 ancestor-rev 
  150.                      &optional startup-hooks merge-buffer-file)
  151. ;; If ANCESTOR-REV non-nil, merge with ancestor
  152.   (let (buf1 buf2 ancestor-buf)
  153.     (save-excursion
  154.       (vc-version-other-window rev1)
  155.       (setq buf1 (current-buffer)))
  156.     (save-excursion
  157.       (or (string= rev2 "")
  158.       (vc-version-other-window rev2))
  159.       (setq buf2 (current-buffer)))
  160.     (if ancestor-rev
  161.     (save-excursion
  162.       (or (string= ancestor-rev "")
  163.           (vc-version-other-window ancestor-rev))
  164.       (setq ancestor-buf (current-buffer))))
  165.     (setq startup-hooks 
  166.       (cons 
  167.        (` (lambda () 
  168.         (delete-file (, (buffer-file-name buf1)))
  169.         (or (, (string= rev2 ""))
  170.             (delete-file (, (buffer-file-name buf2))))
  171.         (or (, (string= ancestor-rev ""))
  172.             (, (not ancestor-rev))
  173.             (delete-file (, (buffer-file-name ancestor-buf))))
  174.         ))
  175.        startup-hooks))
  176.     (if ancestor-rev
  177.     (ediff-merge-buffers-with-ancestor
  178.      buf1 buf2 ancestor-buf
  179.      startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
  180.       (ediff-merge-buffers
  181.        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))
  182.     ))
  183.  
  184. (defun ediff-rcs-merge-internal (rev1 rev2 ancestor-rev
  185.                       &optional
  186.                       startup-hooks merge-buffer-file)
  187.   ;; If ANCESTOR-REV non-nil, merge with ancestor
  188.   (let (buf1 buf2 ancestor-buf)
  189.     (setq buf1 (rcs-ediff-view-revision rev1)
  190.       buf2 (if (string= rev2 "")
  191.            (current-buffer)
  192.          (rcs-ediff-view-revision rev2))
  193.       ancestor-buf (if ancestor-rev
  194.                (if (string= ancestor-rev "")
  195.                    (current-buffer)
  196.                  (rcs-ediff-view-revision ancestor-rev))))
  197.     ;; rcs.el doesn't create temp version files, so we don't have to delete
  198.     ;; anything in startup hooks to ediff-buffers
  199.     (if ancestor-rev
  200.     (ediff-merge-buffers-with-ancestor
  201.      buf1 buf2 ancestor-buf
  202.      startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
  203.       (ediff-merge-buffers
  204.        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
  205.  
  206. (defun ediff-generic-sc-merge-internal (rev1 rev2 ancestor-rev
  207.                          &optional
  208.                          startup-hooks merge-buffer-file)
  209.   ;; If ANCESTOR-REV non-nil, merge with ancestor
  210.   (let (buf1 buf2 ancestor-buf)
  211.     (save-excursion
  212.       (if (string= rev1 "")
  213.       (setq rev1 (generic-sc-get-latest-rev)))
  214.       (sc-visit-previous-revision rev1)
  215.       (setq buf1 (current-buffer)))
  216.     (save-excursion
  217.       (or (string= rev2 "")
  218.       (sc-visit-previous-revision rev2))
  219.       (setq buf2 (current-buffer)))
  220.     (if ancestor-rev
  221.     (save-excursion
  222.       (or (string= ancestor-rev "")
  223.           (sc-visit-previous-revision ancestor-rev))
  224.       (setq ancestor-buf (current-buffer))))
  225.     (if ancestor-rev
  226.     (ediff-merge-buffers-with-ancestor
  227.      buf1 buf2 ancestor-buf
  228.      startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
  229.       (ediff-merge-buffers
  230.        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
  231.  
  232.  
  233. ;; PCL-CVS.el support
  234.  
  235. (defun ediff-pcl-cvs-internal (rev1 rev2 &optional startup-hooks)
  236. ;; Run Ediff on a pair of revisions of the current buffer.
  237. ;; If REV1 is "", use the latest revision.
  238. ;; If REV2 is "", use the current buffer as the second file to compare.
  239.   (let ((orig-buf (current-buffer))
  240.     orig-file-name buf1 buf2 file1 file2)
  241.     
  242.     (or (setq orig-file-name (buffer-file-name (current-buffer)))
  243.     (error "Current buffer is not visiting any file"))
  244.     (if (string= rev1 "") (setq rev1 nil)) ; latest revision
  245.     (setq buf1 (ediff-pcl-cvs-view-revision orig-file-name rev1)
  246.       buf2 (if (string= rev2 "")
  247.            orig-buf
  248.          (ediff-pcl-cvs-view-revision orig-file-name rev2))
  249.       file1 (buffer-file-name buf1)
  250.       file2 (buffer-file-name buf2))
  251.     (setq startup-hooks
  252.       (cons (` (lambda ()
  253.              (delete-file (, file1))
  254.              (or (, (string= rev2 "")) (delete-file (, file2)))
  255.              ))
  256.         startup-hooks))
  257.     (ediff-buffers buf1 buf2 startup-hooks 'ediff-revision)))
  258.  
  259. ;; This function is the standard Ediff's interface to pcl-cvs.
  260. ;; Works like with other interfaces: runs ediff on versions of the file in the
  261. ;; current buffer.
  262. (defun ediff-pcl-cvs-merge-internal (rev1 rev2 ancestor-rev
  263.                       &optional
  264.                       startup-hooks merge-buffer-file)
  265. ;; Ediff-merge appropriate revisions of the selected file.
  266. ;; If REV1 is "" then use the latest revision.
  267. ;; If REV2 is "" then merge current buffer's file with REV1.
  268. ;; If ANCESTOR-REV is "" then use current buffer's file as ancestor.
  269. ;; If ANCESTOR-REV is nil, then merge without the ancestor.
  270.   (let ((orig-buf (current-buffer))
  271.     orig-file-name buf1 buf2 ancestor-buf)
  272.  
  273.     (or (setq orig-file-name (buffer-file-name (current-buffer)))
  274.     (error "Current buffer is not visiting any file"))
  275.     (if (string= rev1 "") (setq rev1 nil)) ; latest revision
  276.  
  277.     (setq buf1 (ediff-pcl-cvs-view-revision orig-file-name rev1))
  278.     (setq buf2 (if (string= rev2 "")
  279.            orig-buf
  280.          (ediff-pcl-cvs-view-revision orig-file-name rev2)))
  281.     (if (stringp ancestor-rev)
  282.     (setq ancestor-buf
  283.           (if (string= ancestor-rev "")
  284.           orig-buf
  285.         (ediff-pcl-cvs-view-revision orig-file-name ancestor-rev))))
  286.  
  287.     (setq startup-hooks 
  288.       (cons 
  289.        (` (lambda () 
  290.         (delete-file (, (buffer-file-name buf1)))
  291.         (or (, (string= rev2 ""))
  292.             (delete-file (, (buffer-file-name buf2))))
  293.         (or (, (string= ancestor-rev ""))
  294.             (, (not ancestor-rev))
  295.             (delete-file (, (buffer-file-name ancestor-buf))))
  296.         ))
  297.        startup-hooks))
  298.  
  299.     (if ancestor-buf
  300.     (ediff-merge-buffers-with-ancestor
  301.      buf1 buf2 ancestor-buf startup-hooks 
  302.      'ediff-merge-revisions-with-ancestor merge-buffer-file)
  303.       (ediff-merge-buffers
  304.        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))
  305.     ))
  306.  
  307. (defun ediff-pcl-cvs-view-revision (file rev)
  308. ;; if rev = "", get the latest revision
  309.   (let ((temp-name (make-temp-name
  310.             (concat ediff-temp-file-prefix
  311.                 "ediff_" rev))))
  312.     (cvs-kill-buffer-visiting temp-name)
  313.     (if rev
  314.     (message "Retrieving revision %s..." rev)
  315.       (message "Retrieving latest revision..."))
  316.     (let ((res (call-process cvs-shell nil nil nil "-c"
  317.                  (concat cvs-program " update -p "
  318.                      (if rev
  319.                      (concat "-r " rev " ")
  320.                        "")
  321.                      file
  322.                      " > " temp-name))))
  323.       (if (and res (not (and (integerp res) (zerop res))))
  324.       (error "Failed to retrieve revision: %s" res))
  325.  
  326.       (if rev
  327.       (message "Retrieving revision %s... Done." rev)
  328.     (message "Retrieving latest revision... Done."))
  329.       (find-file-noselect temp-name))))
  330.  
  331.  
  332. (defun cvs-run-ediff-on-file-descriptor (tin)
  333. ;; This is a replacement for cvs-emerge-mode
  334. ;; Runs after cvs-update.
  335. ;; Ediff-merge appropriate revisions of the selected file.
  336.   (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
  337.      (type (cvs-fileinfo->type fileinfo))
  338.      (tmp-file
  339.       (cvs-retrieve-revision-to-tmpfile fileinfo))
  340.      (default-directory
  341.        (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
  342.      ancestor-file)
  343.     
  344.     (or (memq type '(MERGED CONFLICT MODIFIED))
  345.     (error
  346.      "Can only merge `Modified', `Merged' or `Conflict' files"))
  347.     
  348.     (cond ((memq type '(MERGED CONFLICT))
  349.        (setq ancestor-file
  350.          (cvs-retrieve-revision-to-tmpfile
  351.           fileinfo
  352.           ;; revision
  353.           (cvs-fileinfo->base-revision fileinfo)))
  354.        (ediff-merge-buffers-with-ancestor
  355.         (find-file-noselect tmp-file)
  356.         (find-file-noselect (cvs-fileinfo->backup-file fileinfo))
  357.         (find-file-noselect ancestor-file)
  358.         nil ; startup-hooks
  359.         'ediff-merge-revisions-with-ancestor))
  360.       ((eq type 'MODIFIED)
  361.        (ediff-buffers
  362.         (find-file-noselect tmp-file)
  363.         (find-file-noselect (cvs-fileinfo->full-path fileinfo))
  364.         nil ; startup-hooks
  365.         'ediff-revisions)))
  366.     (if (stringp tmp-file) (delete-file tmp-file))
  367.     (if (stringp ancestor-file) (delete-file ancestor-file))))
  368.  
  369. ;;; Local Variables:
  370. ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
  371. ;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
  372. ;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
  373. ;;; End:
  374.  
  375. (provide 'ediff-vers)
  376.  
  377. ;;; ediff-vers.el ends here
  378.